home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Contributed Scores / Peter Stone Punctus / Prelude#4 < prev    next >
Lisp/Scheme  |  1998-10-26  |  16KB  |  443 lines
  1. ; Why is the player hacking that piano like that! Doesn't he know *rhythmics*?
  2. ; I know - but - hey! - it's just a program.
  3.  
  4. (def-orchestra 'orchestra
  5.    piano (lefthand righthand 3rd-voice)
  6. )
  7.  
  8. (defun make-tr-melody (mel repeat trpat)
  9.   (let ((out nil)
  10.         (master-tr trpat)
  11.         (trval nil))
  12.     (dotimes (i (length trpat))
  13.       (setq trval (car master-tr))
  14.       (setq master-tr (cdr master-tr))
  15.       (if (null master-tr) (setq master-tr trpat))
  16.       (dotimes (j repeat)
  17.         (push (symbol-transpose trval mel) out)))
  18.     (flatten (nreverse out))))
  19.  
  20. ; 14 7 good for piano
  21.  
  22. (setq seedpat1 (vector-to-symbol a h (vector-quantize 7 8 (vector-resynthesize 3 (gen-noise-white 256 1 0.21215454) nil t))))
  23. (setq seedpat2 (symbol-inversion 'e seedpat1))
  24. (setq seedpat3 (vector-to-symbol a h (vector-quantize 7 8 (vector-resynthesize 3 (gen-noise-white 256 1 0.212115154) nil t))))
  25.  
  26. (setq transpat (gen-random 0.2252 11 '(0 0  0 0  0 0  5 5  4 4 4)))
  27. (setq transpat2 (gen-random 0.322252 11 '(0 0  0 0  0 0  5 5  4 4 4)))
  28. (setq transpat3 (gen-random 0.252 11 '(0 0  0 0  0 0  5 5  4 4 4)))
  29.  
  30. (setq melody-1 (symbol-fold 14 7 (make-tr-melody seedpat1 2 transpat)))
  31. (setq melody-2 (symbol-fold 14 7 (make-tr-melody seedpat2 2 transpat2)))
  32.  
  33. (setq tempo-zone-len (/ (get-ratio '12/1 :ratio)
  34.                         (get-ratio '1/8 :ratio)))
  35.  
  36. (setq tempomap1 (gen-fourier 
  37.                       (gen-random 0.514123 5 '(1 2 3 5 8)) ; frequencies
  38.                       '(0.6 0.2 (gen-sin 10 0.22 64) 0.2) ; amplitudes
  39.                       '(0 45 90) ; initial phases
  40.                       tempo-zone-len))
  41.  
  42. (setq tempomap2 (gen-fourier 
  43.                       (gen-random 0.512412 5 '(1 2 3 5 8)) ; frequencies
  44.                       '(0.6 0.2 (gen-sin 10 0.22 64) 0.2) ; amplitudes
  45.                       '(0 45 90) ; initial phases
  46.                       tempo-zone-len))
  47. (def-section intro
  48.   default ; 24 bars
  49.     zone '(1/1 1/1 1/1 1/1  1/1 1/1 1/1 1/1
  50.            1/1 1/1 1/1 1/1  1/1 1/1 1/1 1/1
  51.            1/1 1/1 1/1 1/1  1/1 1/1 1/1 1/1)
  52.     tempo-zones (symbol-repeat 24 '(1/1))
  53.     tempo (vector-to-list (vector-round 96 103 (vector-quantize 12 24 (vector-mix tempomap1 tempomap2))))
  54.     length '(1/16)
  55.     velocity '(64)
  56.   righthand
  57.     tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 5) (major d 5) (melodic-minor f 5)))
  58.     symbol melody-1
  59.     channel 1 
  60.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.39392)))
  61.     duration (vector-to-list (vector-round (get-tick '1/9) (get-tick '1/30) tempomap1))
  62.     velocity (vector-round 60 75 tempomap2)
  63.   lefthand
  64.     tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 4) (major d 4) (melodic-minor f 4)))
  65.     symbol melody-2
  66.     channel 2
  67.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.29392)))
  68.     duration (vector-to-list (vector-round (get-tick '1/9) (get-tick '1/30) tempomap2))
  69.     velocity (vector-round 60 75 tempomap2)
  70.   3rd-voice
  71.     tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 5) (major d 5) (melodic-minor f 4)))
  72.     channel 5 
  73.     length '(1/16)
  74.     symbol '(=)
  75.     velocity '(0)
  76.     duration (same-as length of 3rd-voice)
  77.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.29392)))
  78. )
  79.  
  80. #| This is a comment
  81. (midiport :printer)
  82.  
  83. (play-file-p "prelude-b2"
  84.   piano '(prelude prelude2)
  85. )
  86. |#
  87.  
  88. ;;; part b
  89.  
  90. (setq theme-source 
  91.       (make-tr-melody seedpat1 1 transpat3))
  92.  
  93. (setq theme theme-source)
  94.  
  95. (setq theme-enhansion
  96.       (gen-expansion 1 '(a d c -c b)
  97.                         (symbol-retrograde 
  98.                          (gen-loop '((8 1 1 4) (2 1 1 2))
  99.                                    theme))))
  100.  
  101. (init-soup 'bach-soup theme-enhansion)
  102.  
  103. (setq variations 
  104.     (symbol-trim (* (length theme) 6) 
  105.          (gen-catalyze 'bach-soup 0.123425 30)))
  106.  
  107. (setq melody-1-source 
  108.    (append theme 
  109.            (symbol-transpose 8 
  110.            (symbol-inversion 'a theme)) variations))
  111.  
  112. (setq melody-2-source  
  113.     (symbol-transpose 11 
  114.          (symbol-shift 32 
  115.               (append theme 
  116.                       (symbol-transpose 8 
  117.                            (symbol-inversion 'a theme)) variations))))
  118.  
  119. (setq harmonized-melodies
  120.    (filter-harmonize2 melody-1-source melody-2-source 12 
  121.                    (activate-tonality (harmonic-minor f 3))
  122.                    '((4 4))
  123.                    '((1 2 6 8 10 11))))
  124.  
  125. (setq melody-1-mat (symbol-fold 14 7 (filter-deactivate 8 30 (find-change (car harmonized-melodies)))))
  126. (setq melody-2-mat (symbol-fold 14 7 (filter-deactivate 8 30 (find-change (cadr harmonized-melodies)))))
  127.  
  128. (setq melody-1 melody-1-mat)
  129.  
  130. (setq melody-2
  131.       (symbol-remove
  132.        (find-common melody-1-mat melody-2-mat)
  133.        melody-2-mat))
  134.  
  135. (def-section prelude
  136.   default
  137.     zone '(12/1)
  138.     tempo-zones (symbol-trim tempo-zone-len '(1/8))
  139.     tempo       (vector-to-list (vector-round 70 90 tempomap1))
  140.     tonality (activate-tonality (harmonic-minor f 3))
  141.   lefthand
  142.     channel 3 
  143.     symbol (symbol-melodize-skip melody-1)
  144.     length (get-timing '1/16 melody-1)
  145.     duration (change-length times 1.3 (same-as length of lefthand))
  146.     velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
  147.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.19392)))
  148.   righthand
  149.     channel 4 
  150.     symbol (symbol-shift 1 (symbol-melodize-skip melody-2))
  151.     length (get-timing '1/16 melody-2)
  152.     duration (change-length times 1.3 (same-as length of righthand))
  153.     velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
  154.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.9392)))
  155.   3rd-voice
  156.     tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 5) (major d 5) (melodic-minor f 4)))
  157.     channel 5 
  158.     length '(1/16)
  159.     duration (same-as length of 3rd-voice)
  160.     symbol '(=)
  161.     velocity '(0)
  162.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.29392)))
  163. )
  164.  
  165. (setq theme-source 
  166.       (make-tr-melody seedpat2 1 transpat3))
  167.  
  168. (setq theme theme-source)
  169.  
  170. (setq theme-enhansion
  171.       (gen-expansion 1 '(a d c -c b)
  172.                         (symbol-retrograde 
  173.                          (gen-loop '((8 1 1 4) (2 1 1 2))
  174.                                    theme))))
  175.  
  176. (init-soup 'bach-soup theme-enhansion)
  177.  
  178. (setq variations 
  179.     (symbol-trim (* (length theme) 6) 
  180.          (gen-catalyze 'bach-soup 0.123425 30)))
  181.  
  182. (setq melody-1-source 
  183.    (append theme 
  184.            (symbol-transpose 8 
  185.            (symbol-inversion 'a theme)) variations))
  186.  
  187. (setq melody-2-source  
  188.     (symbol-transpose 11 
  189.          (symbol-shift 32 
  190.               (append theme 
  191.                       (symbol-transpose 8 
  192.                            (symbol-inversion 'a theme)) variations))))
  193.  
  194. (setq harmonized-melodies
  195.    (filter-harmonize2 melody-1-source melody-2-source 12 
  196.                    (activate-tonality (harmonic-minor f 3))
  197.                    '((4 4))
  198.                    '((1 2 6 8 10 11))))
  199.  
  200. (setq melody-1 (filter-deactivate 8 30 (find-change (car harmonized-melodies))))
  201. (setq melody-2 (filter-deactivate 8 30 (find-change (cadr harmonized-melodies))))
  202.  
  203. (def-section prelude2
  204.   default
  205.     zone '(12/1)
  206.     tempo-zones (symbol-trim tempo-zone-len '(1/8))
  207.     tempo       (vector-to-list (vector-round 60 80 tempomap2))
  208.     tonality (activate-tonality (harmonic-minor f 3))
  209.   lefthand
  210.     channel 3 
  211.     symbol (symbol-melodize-skip melody-1)
  212.     length (get-timing '1/16 melody-1)
  213.     velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
  214.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.8392)))
  215.     duration (change-length times 0.9 (same-as length of lefthand))
  216.   righthand
  217.     channel 4 
  218.     symbol (symbol-shift 1 (symbol-melodize-skip melody-2)) 
  219.     length (get-timing '1/16 melody-2)
  220.     velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
  221.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.7392)))
  222.     duration (change-length times 0.9 (same-as length of righthand))
  223.   3rd-voice
  224.     tonality (symbol-repeat 2 (activate-tonality (melodic-minor c 5) (major d 5) (melodic-minor f 4)))
  225.     channel 5 
  226.     length '(1/16)
  227.     symbol '(=)
  228.     velocity '(0)
  229.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.29392)))
  230.     duration (same-as length of 3rd-voice)
  231. )
  232.  
  233. #| This is a comment
  234. (play-file-p "prelude-b"
  235.   piano '(prelude prelude2)
  236. )
  237.  |#
  238.  
  239. ;;; fugue
  240.  
  241. (setq theme-source 
  242.       (append seedpat1 
  243.               seedpat3
  244.               seedpat2
  245.               (reverse seedpat3)))
  246.  
  247. (setq theme theme-source)
  248.  
  249. (setq theme-enhansion
  250.       (gen-expansion 1 '(a d c -c b)
  251.                         (symbol-retrograde 
  252.                          (gen-loop '((8 1 1 4) (2 1 1 2))
  253.                                    theme))))
  254.  
  255. (init-rnd 0.41123)
  256. (init-soup 'bach-soup theme-enhansion)
  257.  
  258. (setq variations 
  259.     (symbol-trim (* (length theme) 6) 
  260.          (gen-catalyze 'bach-soup 0.1521412123425 30)))
  261.  
  262. (setq melody-1-source 
  263.    (append theme 
  264.            (symbol-transpose 8 
  265.            (symbol-inversion 'a theme)) variations))
  266.  
  267. (setq melody-2-source  
  268.     (symbol-transpose 11 
  269.          (symbol-shift (* 32 1 2) 
  270.               (append theme 
  271.                       (symbol-transpose 8 
  272.                            (symbol-inversion 'a theme)) variations))))
  273.  
  274. (setq melody-3-source
  275.     (symbol-transpose -5 
  276.          (symbol-shift (* 32 2 2) 
  277.               (append theme 
  278.                       (symbol-transpose 8 
  279.                            (symbol-inversion 'a theme)) variations))))
  280.  
  281. (setq harmonized-melodies
  282.       (filter-harmonize3
  283.           melody-1-source melody-2-source melody-3-source 12
  284.           (activate-tonality (harmonic-minor f 3))
  285.           '((64 3) (32 3)) 
  286.           '((1 2 6 8 10 11))
  287.           '(0 5 7)))
  288.  
  289. (setq melody-1 (symbol-fold 14 0 (filter-deactivate 16 69 (find-change (car harmonized-melodies)))))
  290. (setq melody-2 (symbol-fold 21 0 (filter-deactivate 16 69 (find-change (cadr harmonized-melodies)))))
  291. (setq melody-3 (symbol-fold 14 0 (filter-deactivate 16 69 (find-change (caddr harmonized-melodies)))))
  292.  
  293. (def-section fugue
  294.   default
  295.     zone '(16/1)
  296.     tempo-zones (symbol-trim tempo-zone-len '(1/8))
  297.     tempo       (vector-to-list (vector-round 73 78 tempomap2))
  298.     tonality (activate-tonality (harmonic-minor f 3))
  299.   lefthand
  300.     channel 1 
  301.     length (get-timing '1/16 melody-1)
  302.     symbol (symbol-melodize-skip melody-1)
  303.     velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
  304.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.6392)))
  305.     duration (change-length times 1.1 (same-as length of lefthand)) 
  306.   righthand
  307.     channel 4 
  308.     length (get-timing '1/16 melody-2)
  309.     symbol (symbol-shift 1 (symbol-melodize-skip melody-2)) 
  310.     velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
  311.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.5392)))
  312.     duration (change-length times 1.1 (same-as length of righthand))
  313.   3rd-voice
  314.     channel 5 
  315.     tonality (activate-tonality (harmonic-minor f 4))
  316.     length (get-timing '1/16 melody-3)
  317.     symbol (symbol-shift 1 (symbol-melodize-skip melody-3)) ;; imitation with 2nd melody rhythm!!
  318.     velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
  319.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.4392)))
  320.     duration (change-length times 1.1 (same-as length of 3rd-voice))
  321. )
  322. #| 
  323. (play-file-p "prelude-b"
  324.   piano '(fugue)
  325. )
  326. |#
  327.  
  328. ;;; fugue2
  329.  
  330. (setq theme-source 
  331.       (gen-random-variate 0.3122841 0.5 2 2 (symbol-inversion 'g
  332.                                                            (append seedpat1 
  333.                                                                    seedpat3
  334.                                                                    seedpat2
  335.                                                                    (reverse seedpat3)))))
  336.  
  337. (setq theme theme-source)
  338.  
  339. (setq theme-enhansion
  340.       (gen-expansion 1 '(a d c -c b)
  341.                         (symbol-retrograde 
  342.                          (gen-loop '((8 1 1 4) (2 1 1 2))
  343.                                    theme))))
  344.  
  345. (init-rnd 0.21453)
  346. (init-soup 'bach-soup theme-enhansion)
  347.  
  348. (setq variations 
  349.     (symbol-trim (* (length theme) 6) 
  350.          (gen-catalyze 'bach-soup 0.115214212123425 30)))
  351.  
  352. (setq melody-1-source 
  353.    (append theme 
  354.            (symbol-transpose 8 
  355.            (symbol-inversion 'a theme)) variations))
  356.  
  357. (setq melody-2-source  
  358.     (symbol-transpose 5 
  359.          (symbol-shift (* 32 1 2) 
  360.               (append theme 
  361.                       (symbol-transpose 8 
  362.                            (symbol-inversion 'a theme)) variations))))
  363.  
  364. (setq melody-3-source
  365.     (symbol-transpose -3 
  366.          (symbol-shift (* 32 2 2) 
  367.               (append theme 
  368.                       (symbol-transpose 8 
  369.                            (symbol-inversion 'a theme)) variations))))
  370.  
  371. (setq harmonized-melodies
  372.       (filter-harmonize3
  373.           melody-1-source melody-2-source melody-3-source 12
  374.           (activate-tonality (harmonic-minor f 3))
  375.           '((64 3) (32 3)) 
  376.           '((1 2 10 11))
  377.           '(0 5 7)))
  378.  
  379. (setq melody-1 (symbol-fold 14 7 (filter-deactivate 16 59 (find-change (car harmonized-melodies)))))
  380. (setq melody-2 (symbol-fold 21 0 (filter-deactivate 16 59 (find-change (cadr harmonized-melodies)))))
  381. (setq melody-3 (symbol-fold 14 7 (filter-deactivate 16 59 (find-change (caddr harmonized-melodies)))))
  382.  
  383. (def-section fugue2
  384.   default
  385.     zone '(16/1)
  386.     tonality (activate-tonality (harmonic-minor f 3))
  387.     tempo-zones (symbol-trim tempo-zone-len '(1/8))
  388.     tempo       (vector-to-list (vector-round 70 77 tempomap2))
  389.   lefthand
  390.     channel 1 
  391.     length (get-timing '1/16 melody-1)
  392.     symbol (symbol-melodize-skip melody-1)
  393.     velocity (symbol-to-velocity 65 110 3 (symbol-repeat 4 theme))
  394.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.3392)))
  395.     duration (same-as length of lefthand)
  396.   righthand
  397.     channel 4 
  398.     length (get-timing '1/16 melody-2)
  399.     symbol (symbol-shift 1 (symbol-melodize-skip melody-2)) 
  400.     velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
  401.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.2392)))
  402.     duration (same-as length of righthand)
  403.   3rd-voice
  404.     channel 5 
  405.     tonality (activate-tonality (harmonic-minor f 4))
  406.     length (get-timing '1/16 melody-3)
  407.     symbol (symbol-shift 1 (symbol-melodize-skip melody-3)) ;; imitation with 2nd melody rhythm!!
  408.     velocity (symbol-to-velocity 65 110 3 (reverse (symbol-repeat 4 theme)))
  409.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white 128 1 0.1392)))
  410.     duration (same-as length of 3rd-voice)
  411. )
  412.  
  413. (def-section cadenze
  414.   default
  415.     zone '(2/1 1/1)
  416.     tonality (activate-tonality (major f 3))
  417.     length '((1/8) (1/1))
  418.     velocity '(84)
  419.     tuning '(0)
  420.     duration as-length
  421.     tempo-zones '(2/1 1/1)
  422.     tempo       '(80 80)
  423.   lefthand
  424.     channel 1
  425.     symbol (list (symbol-mix '(p = n n o = = = o = = o n = = n l)
  426.                              '(r (-1 t) s r s r (-1 q) p (-1 q) = = r p = = o))
  427.                  '(ol))
  428.   righthand
  429.     channel 2
  430.     symbol (list (symbol-mix '(g = k k (-1 j) = (-1 m) = l = = l = = k k j)    
  431.                              '(b = i i (-1 j) = k = l = k k l = e e a))
  432.                  '(ja))
  433.   3rd-voice
  434.     channel 3
  435.     symbol '(=)
  436. )
  437.  
  438. (midiport :printer)
  439.  
  440. (play-file-p "prelude&fugue#4.mid"
  441.   piano '(intro prelude prelude2 fugue fugue2 cadenze)
  442. )
  443.